home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1996-03-20 | 9.2 KB | 224 lines |
- Syntax10.Scn.Fnt
- StampElems
- Alloc
- 20 Mar 96
- Syntax10b.Scn.Fnt
- FoldElems
- Syntax10.Scn.Fnt
- MODULE Folds; (* HM
- IMPORT
- Display, Input, Files, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
- CONST
- profile = "Folds.Profile";
- CR = 0DX;
- ErrElem = POINTER TO ErrElemDesc;
- ErrElemDesc = RECORD(Texts.ElemDesc)
- err: INTEGER
- END;
- Options = ARRAY 16 OF CHAR;
- w: Texts.Writer;
- errT: Texts.Text;
- compName, errFile: ARRAY 24 OF CHAR;
- globOpt: Options;
- showWarnings: BOOLEAN;
- PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);
- END NoNotify;
- PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;
- BEGIN RETURN e IS ErrElem
- END ErrCheck;
- PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);
- VAR i: INTEGER;
- BEGIN i := 0;
- WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
- IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
- REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
- END;
- opt[i] := 0X
- END GetOptions;
- PROCEDURE MarkedFrame (): TextFrames.Frame;
- VAR v: Viewers.Viewer;
- BEGIN v := Oberon.MarkedViewer();
- IF v.dsc.next IS TextFrames.Frame THEN RETURN v.dsc.next(TextFrames.Frame)
- ELSE RETURN NIL
- END MarkedFrame;
- PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);
- VAR x, y, h: INTEGER;
- BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
- v := MenuViewers.New(TextFrames.NewMenu("", ""),
- TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
- Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
- Viewers.minH := h
- END OpenTempViewer;
- PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);
- VAR end, delta: LONGINT;
- BEGIN delta := 200;
- LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
- IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
- TextFrames.Show(f, pos - delta); DEC(delta, 20)
- END Show;
- PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);
- VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
- BEGIN
- WITH E: ErrElem DO
- WITH
- msg: TextFrames.DisplayMsg DO
- IF ~msg.prepare THEN
- w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
- Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 2, w - 2, h, Display.replace)
- END
- | msg: TextFrames.TrackMsg DO
- REPEAT
- Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
- UNTIL keys = {}
- | msg: Texts.CopyMsg DO
- NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
- ELSE (*ignore it*)
- END
- END HandleErr;
- PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text);
- VAR S: Texts.Scanner; pos, delta: LONGINT; err: INTEGER; log: Texts.Text; r: Texts.Reader; ch: CHAR; e: ErrElem;
- BEGIN
- log := Oberon.Log; pos := log.len;
- REPEAT DEC(pos); Texts.OpenReader(r, log, pos); Texts.Read(r, ch) UNTIL ch = "c";
- REPEAT INC(pos); Texts.Read(r, ch) UNTIL ch < " ";
- delta := 0; Texts.OpenScanner(S, log, pos+1);
- LOOP S.line := 0;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
- IF S.eot OR (S.line # 0) THEN EXIT END;
- pos := S.i;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
- IF S.eot OR (S.line # 0) THEN EXIT END;
- IF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
- NEW(e); e.W := 3*TextFrames.mm; e.H := e.W; e.handle := HandleErr; e.err := SHORT(S.i);
- Texts.WriteElem(w, e); Texts.Insert(t, pos + delta, w.buf);
- INC(delta)
- END;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
- END InsertErrElems;
- PROCEDURE DeleteErrElems (t: Texts.Text);
- VAR r: Texts.Reader; pos: LONGINT;
- BEGIN Texts.OpenReader(r, t, 0);
- LOOP Texts.ReadElem(r);
- IF r.elem = NIL THEN EXIT
- ELSIF r.elem IS ErrElem THEN
- pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos)
- END
- END DeleteErrElems;
- PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;
- VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
- BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
- IF end + 1 = f.text.len THEN INC(end) END;
- -- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
- Texts.OpenReader(r, f.text, f.org);
- LOOP Texts.ReadElem(r);
- IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
- ELSIF r.elem IS ErrElem THEN RETURN TRUE
- END
- END ErrVisible;
- PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);
- VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
- BEGIN Texts.OpenScanner(s, errT, 0);
- REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
- WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
- IF ~s.eot THEN Texts.Read(s, ch); n := 0;
- WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
- msg[n] := 0X
- END GetErrMsg;
- PROCEDURE SetProfile*;
- VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
- BEGIN
- compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
- f := Files.Old(profile);
- IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
- WHILE ~ s.eot DO
- IF s.class = Texts.Name THEN
- IF s.s = "compiler" THEN
- Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
- GetOptions(s, globOpt)
- ELSIF s.s = "errorFile" THEN
- Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
- ELSIF s.s = "showWarnings" THEN
- Texts.Scan(s); Texts.Scan(s);
- showWarnings := s.s = "yes"
- END
- END;
- Texts.Scan(s)
- END
- END;
- errT := TextFrames.Text(errFile)
- END SetProfile;
- PROCEDURE Compile*;
- VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
- beg, end, time: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
- ready: BOOLEAN; opt: Options;
- BEGIN
- par := Oberon.Par;
- Texts.OpenScanner(s, par.text, par.pos);
- REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
- IF par.vwr.dsc = par.frame THEN
- f := par.frame.next(TextFrames.Frame);
- Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
- Oberon.FadeCursor(Oberon.Pointer);
- t := f.text; opt := globOpt; ready := TRUE
- ELSE
- IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
- ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
- f := MarkedFrame(); IF f # NIL THEN t := f.text END;
- ready := TRUE
- ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
- Oberon.GetSelection(t, beg, end, time);
- IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s);
- IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
- END
- END;
- GetOptions(s, opt)
- END;
- IF t # NIL THEN
- DeleteErrElems(t);
- oldNotify := t.notify; t.notify := NoNotify;
- FoldElems.ExpandAll(t, 0, TRUE);
- IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
- par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
- Texts.Append(par.text, w.buf); par.pos := 0;
- Oberon.Call(compName, par, FALSE, res);
- IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t) END;
- FoldElems.CollapseAll(t, {FoldElems.tempLeft});
- IF f = NIL THEN
- Viewers.Close(v)
- ELSE
- t.notify := oldNotify;
- IF ErrVisible(f) THEN t.notify(t, Texts.replace, 0, t.len) END
- END
- END
- UNTIL (t = NIL) OR ready
- END Compile;
- PROCEDURE ShowError*;
- VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
- BEGIN
- IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next;
- ELSE F := Oberon.MarkedViewer();
- IF (F .dsc # NIL) & (F.dsc.next # NIL) THEN F := F.dsc.next END ;
- END ;
- WITH F: TextFrames.Frame DO
- IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
- FoldElems.FindElem(F.text, pos, ErrCheck, e); (*<<RD*)
- FoldElems.FindElem(F.text, pos, ErrCheck, e, pos);
- IF e # NIL THEN
- pos:=Texts.ElemPos(e); (*<<RD*)
- Show(F, pos);
- TextFrames.SetCaret(F, pos + 1);
- GetErrMsg(e(ErrElem).err, msg);
- Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
- END
- ELSE
- END ShowError;
- PROCEDURE Restore*;
- VAR f: TextFrames.Frame;
- BEGIN
- f := MarkedFrame();
- IF f # NIL THEN FoldElems.CollapseAll(f.text, {FoldElems.findLeft}) END
- END Restore;
- BEGIN
- Texts.OpenWriter(w); SetProfile
- END Folds.
-